home *** CD-ROM | disk | FTP | other *** search
/ The Pier Shareware 1 / Pier Shareware 1.iso / 007a / courspas.exe / CHAP11.EXE / TYP3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1980-01-04  |  3.6 KB  |  124 lines
  1. program m_a_jour_fichier_type; {TYP3.PAS}
  2. uses
  3.   crt;  { unité de Turbo Pascal 6 }
  4.  
  5. const
  6.   nom = 'TESTSTR.DAT';  { fichier sur disquette }
  7.  
  8. type
  9.   str20 = string[20];
  10.  
  11. var
  12.   element: str20;
  13.   f      : file of str20;
  14.  
  15. {------------------------------------------------}
  16. { attendre                                         }
  17. {------------------------------------------------}
  18. procedure attendre;
  19. var  ch: char;
  20. begin
  21.   gotoxy(1,25); write('Veuillez appuyer sur une touche...');
  22.   ch:= readkey;
  23.   gotoxy(1,25); clreol
  24. end;
  25. {------------------------------------------------}
  26. { lireElements                                  }
  27. {------------------------------------------------}
  28. procedure lireElements;
  29. var  i: integer; { compteur }
  30.  
  31. begin
  32.   clrscr;
  33.   seek(f,0);   { pointeur au début du fichier }
  34.   writeln('Liste des éléments contenus par le fichier:');
  35.   writeln;
  36.   writeln('Nombre d''éléments: ',filesize(f));
  37.   writeln;
  38.   i:= 0;   { valeur de début }
  39.   while not eof(f) do
  40.   begin
  41.     inc(i);           { i:= i+1, pour compter }
  42.     read(f,element);  { lecture des éléments  }
  43.     writeln(i:3,': ',element); { affichage    }
  44.   end; { while }
  45.   attendre;
  46. end;
  47. {------------------------------------------------}
  48. { m_a_jour_enregistr                             }
  49. {------------------------------------------------}
  50. procedure m_a_jour_enregistr;
  51. var
  52.   nombr,             { nombre d'enregistrements  }
  53.   pos  : integer;    { position de la modif.     }
  54.  
  55. begin
  56.   repeat
  57.     clrscr;
  58.     writeln('Mise à jour des enregistrements!');
  59.     writeln('Pour Q U I T T E R, frappez 0');
  60.     writeln;
  61.     nombr:= filesize(f);
  62.     writeln;
  63.     writeln('Valeurs possibles de POS: ');
  64.     writeln('  1 <= POS <= ',nombr);
  65.     repeat
  66.       gotoxy(20,10);
  67.       write('Position de la modification? ');
  68.       readln(pos);
  69.       pos:=pos-1;
  70.           until (pos >= -1) and (pos <= nombr-1);
  71.     if pos <> -1
  72.     then begin
  73.            seek(f,pos);    { pointeur sur l'élément }
  74.            read(f,element);{ lecture de l'élément   }
  75.            gotoxy(20,12);
  76.            write('Contenu actuel: ',element);
  77.            gotoxy(20,14);
  78.            write('Nouveau contenu?: ');
  79.            readln(element);
  80.            seek(f,pos);    { pointeur sur l'élément }
  81.            write(f,element); { écriture de l'élément}
  82.            lireElements;
  83.          end;
  84.   until pos = -1;
  85. end;
  86. {------------------------------------------------}
  87. { ajout_enregistr                                }
  88. {------------------------------------------------}
  89. procedure ajout_enregistr;
  90. var  nomFamill: str20;  { nouvel enregistrement  }
  91. begin
  92.   writeln('Ajouter 1 élément au fichier ',nom,':');
  93.   writeln;
  94.   seek(f,filesize(f)); { derrière le dernier élément}
  95.   write('Veuillez introduire un nom (20 car. max.): ');
  96.   readln(nomFamill);
  97.   write(f,nomFamill);     { écriture dans le fichier }
  98.   lireElements;       { affichage du nouveau contenu }
  99. end;
  100. {------------------------------------------------}
  101.  
  102. begin { programme principal }
  103.   clrscr;
  104.   assign(f,nom);   { liaison des fichiers        }
  105.   {$I-}            { inhibe la détect. d'erreurs }
  106.   reset(f);        { ouvre le fichier précédent  }
  107.   {$I+}            { rétabl. la détect. d'erreurs }
  108.   if ioResult = 0
  109.   then begin
  110.          ajout_enregistr;
  111.          m_a_jour_enregistr;
  112.          close(f);
  113.        end
  114.   else begin
  115.          writeln('Erreur à l''ouverture');
  116.          writeln('du fichier!        ');
  117.          writeln;
  118.          writeln('Prog. interrompu!  ');
  119.          attendre;
  120.        end;
  121.   clrscr;
  122.   attendre;
  123. end.
  124.